perm filename OLD[GEO,BGB]1 blob
sn#001321 filedate 1972-10-28 generic text, type T, neo UTF8
00100 α ABBREVIATIONS FOR PROCEDURE DECLARATIONS;
00200 DEFINE XISUBR= "EXTERNAL INTEGER SIMPLE PROCEDURE";
00300 DEFINE XRSUBR= "EXTERNAL REAL SIMPLE PROCEDURE";
00400 DEFINE XSUBR = "EXTERNAL SIMPLE PROCEDURE";
00500 DEFINE ISUBR = "INTEGER SIMPLE PROCEDURE";
00600 DEFINE RSUBR = "REAL SIMPLE PROCEDURE";
00700 DEFINE BSUBR = "BOOLEAN SIMPLE PROCEDURE";
00800
00900 α YE OLDE MNEMONICS;
01000 ISUBR LAC (ITG Q); START_CODE MOVE 1,@Q END;
01100 RSUBR LACR(ITG Q); START_CODE MOVE 1,@Q END;
01200 ISUBR CAR (ITG Q); START_CODE HLRZ 1,@Q END;
01300 ISUBR CDR (ITG Q); START_CODE HRRZ 1,@Q END;
01400 SUBR DAC (ITG N,Q); START_CODE MOVE N; MOVEM @Q END;
01500 SUBR DACR(REAL X;ITG Q);START_CODE MOVE X;MOVEM @Q END;
01600 SUBR DIP (ITG N,Q); START_CODE MOVE N; HRLM @Q END;
01700 SUBR DAP (ITG N,Q); START_CODE MOVE N; HRRM @Q END;
01800 ISUBR NIP (ITG Q); START_CODE HLRE 1,@Q END;
01900 ISUBR NAP (ITG Q); START_CODE HRRE 1,@Q END;
02000 DEFINE INCREM(A)="A←A+1";
02100 DEFINE DECREM(A)="A←A-1";
02200
02300 α FATAL MESSAGE;
02400 SUBR FATAL (STRING S);
02500 ⊂ OUTSTR(↓&"FATAL ERROR - "&S&↓);
02600 WHILE TRUE DO INCHRW ⊃;
02700 α UBFEV NUMBER;
02800 ISUBR ITYPE (ITG X);
02900 RETURN(CASE(CAR(X)LAND '17)OF
03000 (0,1,2,0, 3,0,0,0, 4,0,0,0, 0,0,0,0));
03100 α ENTITY TYPES;
03200 BSUBR BTYPE(ITG X); RETURN((CAR(X)LAND 1)≠0);
03300 BSUBR FTYPE(ITG X); RETURN((CAR(X)LAND 2)≠0);
03400 BSUBR ETYPE(ITG X); RETURN((CAR(X)LAND 4)≠0);
03500 BSUBR VTYPE(ITG X); RETURN((CAR(X)LAND 8)≠0);
03600 α WORLD CONTEXT;
03700 EXTERNAL ITG WORLD,BTOTAL,FTOTAL,ETOTAL,VTOTAL;
00100 α FETCH LINK FROM NODE;
00200 XISUBR PART (ITG E); XISUBR COPART(ITG E);
00300 XISUBR EXTENT(ITG E); XISUBR LOCOR (ITG E);
00400 XISUBR PNAME (ITG E); XISUBR DISK (ITG E);
00500 XISUBR TYPE (ITG E); XISUBR SERIAL(ITG E);
00600 XISUBR NFACE (ITG E); XISUBR PFACE (ITG E);
00700 XISUBR NED (ITG E); XISUBR PED (ITG E);
00800 XISUBR NVT (ITG E); XISUBR PVT (ITG E);
00900 XISUBR NCW (ITG E); XISUBR PCW (ITG E);
01000 XISUBR NCCW (ITG E); XISUBR PCCW (ITG E);
01100 XISUBR FCNT (ITG E); XISUBR VCNT (ITG E);
01200 XISUBR ECNT (ITG E); XISUBR PCNT (ITG E);
01300 XISUBR NBODY (ITG E); XISUBR PBODY (ITG E);
01400 XISUBR NUF (ITG E); XISUBR PUF (ITG E);
01500 XISUBR NCNT (ITG E); XISUBR TJOINT(ITG E);
01600 XISUBR X1DC (ITG E); XISUBR Y1DC (ITG E);
01700 XISUBR X2DC (ITG E); XISUBR Y2DC (ITG E);
01800 XRSUBR XDC (ITG E); XRSUBR YDC (ITG E);
01900 XISUBR ALT(ITG E);
02000
02100 α STORE LINK INTO NODE;
02200 XISUBR PART. (ITG Q,E); XISUBR COPAR.(ITG Q,E);
02300 XISUBR EXTEN.(ITG Q,E); XISUBR LOCOR.(ITG Q,E);
02400 XISUBR PNAME.(ITG Q,E); XISUBR DISK. (ITG Q,E);
02500 XISUBR TYPE. (ITG Q,E); XISUBR SERIA.(ITG Q,E);
02600 XISUBR NFACE.(ITG Q,E); XISUBR PFACE.(ITG Q,E);
02700 XISUBR NED. (ITG Q,E); XISUBR PED. (ITG Q,E);
02800 XISUBR NVT. (ITG Q,E); XISUBR PVT. (ITG Q,E);
02900 XISUBR NCW.. (ITG Q,E); XISUBR PCW.. (ITG Q,E);
03000 XISUBR NCCW..(ITG Q,E); XISUBR PCCW..(ITG Q,E);
03100 XISUBR FCNT. (ITG Q,E); XISUBR VCNT. (ITG Q,E);
03200 XISUBR ECNT. (ITG Q,E); XISUBR PCNT. (ITG Q,E);
03300 XISUBR NBODY.(ITG Q,E); XISUBR PBODY.(ITG Q,E);
03400 XISUBR NUF. (ITG Q,E); XISUBR PUF. (ITG Q,E);
03500 XISUBR NCNT. (ITG Q,E); XISUBR TJOIN.(ITG Q,E);
03600 XISUBR ALT.(ITG Q,E);
03700
00100 α FETCH DATA FROM NODE;
00200
00300 DEFINE
00400 AA(E)="MEMORY[E-3,REAL]",
00500 BB(E)="MEMORY[E-2,REAL]",
00600 CC(E)="MEMORY[E-1,REAL]",
00700 KK(E)="MEMORY[E+4,REAL]",
00800
00900 XWC(V)="MEMORY[V-3,REAL]",
01000 YWC(V)="MEMORY[V-2,REAL]",
01100 ZWC(V)="MEMORY[V-1,REAL]",
01110
01200 XPP(V)="MEMORY[V+4,REAL]",
01300 YPP(V)="MEMORY[V+5,REAL]",
01400 ZPP(V)="MEMORY[V+6,REAL]";
01450
01500 XRSUBR IX(ITG E); XRSUBR IY(ITG E); XRSUBR IZ(ITG E);
01600 XRSUBR JX(ITG E); XRSUBR JY(ITG E); XRSUBR JZ(ITG E);
01700 XRSUBR KX(ITG E); XRSUBR KY(ITG E); XRSUBR KZ(ITG E);
00100 α DYNAMIC FREE STORAGE;
00200 XISUBR GETBLK(ITG SIZE);
00300 XSUBR RELBLK(ITG ADDR);
00400
00500 α BFEV MAKE & KILL OPERATIONS;
00600 XISUBR MKB(ITG B); XSUBR KLB(ITG BNEW);
00700 XISUBR MKF(ITG B); XSUBR KLF(ITG B,FNEW);
00800 XISUBR MKE(ITG B); XSUBR KLE(ITG B,ENEW);
00900 XISUBR MKV(ITG B); XSUBR KLV(ITG B,VNEW);
01000 XISUBR MKBFV; XSUBR KLBFEV(ITG Q);
01100
01200 α WING MAKE LINK OPERATIONS;
01300 XSUBR WING(ITG E1,E2);
01400 XSUBR NCW.(ITG Q,E); XSUBR PCW.(ITG Q,E);
01500 XSUBR NCCW.(ITG Q,E); XSUBR PCCW.(ITG Q,E);
01600
01700 α ORIENTED WING FETCH & STORE OPERATIONS;
01800 XISUBR ECW(ITG E,Q);
01900 XISUBR ECCW(ITG E,Q);
02000 XISUBR OTHER(ITG E,Q); XISUBR OTHER.(ITG Q,E,X);
02100
02200 α BFV FETCH OPERATIONS;
02300 XISUBR BODY(ITG Q); XISUBR MKPARTS(ITG B);
02400 XISUBR FCW(ITG E,V); XISUBR FCCW(ITG E,V);
02500 XISUBR VCW(ITG E,F); XISUBR VCCW(ITG E,F);
02600
02700 α EULER SURFACE OPERATIONS;
02800 XISUBR MKEV(ITG F,V);
02900 XISUBR MKFE(ITG V1,F,V2);
03000 XISUBR ESPLIT(ITG E);
03100 XISUBR KLEV(ITG VNEW);
03200 XISUBR KLFE(ITG ENEW);
03300 XSUBR INVERT(ITG E);
03400 XSUBR EVERT(ITG B);
03500
00100 α PARTS PRIMITIVES;
00200 XISUBR SUPART(ITG B);
00300 XSUBR ATTACH(ITG B1,B2);
00400 XSUBR DETACH(ITG B);
00500 α SOLID OPERATIONS;
00600
00700 α SOLID BOOLEAN OPERATIONS;
00800
00900 α THE FOUR EUCLIDEAN TRANSFORMATIONS;
01000 XSUBR TRANSLATE (ITG Q,R);
01100 XSUBR ROTATE (ITG Q,R);
01200 XSUBR DILATE (ITG Q,R);
01300 XSUBR REFLECT (ITG Q,R);
01400
01500 α IMAGE SYNTHESIS OPERATIONS;
01600 XISUBR MKLOCOR;
01700 XSUBR BLIT(ITG B,A,N);
01800 XSUBR PROJECTOR (ITG CAMERA,ALBODY);
01900 XSUBR FMARK(ITG ALBODY);
02000 XSUBR EMARK(ITG ALBODY);
02100 XSUBR EMARKALL(ITG ALBODY);
02200 XISUBR CLIPER (ITG WINDOW,ALBODY);
02300 α IMAGE ANALYSIS OPERATIONS;
00100 α RING OPERATIONS;
00200 XSUBR RINGIN(ITG E,Q,N);
00300 XSUBR RINGO(ITG E,N);
00400 XISUBR EMPTY(ITG E,N);
00500
00600 α RING POSITION NUMBERS; DEFINE
00700 #QRING = "-1",
00800 #LDX = "1", #XL = "1",
00900 #LDY = "2", #XH = "2",
01000 #LDZ = "3", #YL = "3",
01100 #PDX = "4", #YH = "4",
01200 #PDY = "5",
01300 #FOCAL = "6", #ALBODY = "6",
01400 #OX = "5",
01500 #OY = "6",
01600 #DX = "7", #MAGX = "7",
01700 #DY = "8", #MAGY = "8",
01800 #CAMERA = "-4",
01900 #LOCOR = "-3",
02000 #XSCALE = "7",
02100 #YSCALE = "8",
02200 #ZSCALE = "9",
02300 #SOX="-2",
02400 #SOY="-1";